Collection of Tools & Utilities/Collection of Tools and Utilities.iso/tex/mknews10.zip/MAKENEWS.PAS

Pascal/Delphi Source File | 1994-02-26 | 3KB | 161 lines

program makenews;  {turn files into a newsgroup}

{

to turn single-message-per-file mail into a newsgroup-type structure,
  use this program alone.
to turn MMDF multiple-messages-per-file mail into a newsgroup-type
  structure, use this program after a program which will break the
  MMDF mailbox into separate files.  check for `explode' or the like.

I use this to turn my incoming mail into a newsgroup, so I can use my
  newsreader to read it (and thread it, and the like).  I like the
  interface better.

v1.0

Russell Schulz
[e-mail] (930226)

}

uses dos;

const
  bufsize=1024;

var
  parm: integer;
  basedir: string;
  fileinfo: searchrec;
  tempi: integer;
  filespec: string;
  buffer: array[1..bufsize] of char;

procedure usage;

begin
  writeln('usage:  makenews directory filespec [filespec ...]');
  writeln('eg.  makenews d:\news\foo\mail\joe d:\user\joe\joe.*');
  halt(1);
end;

procedure copyfile(oldfn,newfn: string);

var
  infile, outfile: file;
  done: boolean;
  numread: word;

begin
  assign(infile,oldfn);
  reset(infile,1);
  assign(outfile,newfn);
  rewrite(outfile,1);
  done := false;
  while not done do
    begin
      blockread(infile,buffer,bufsize,numread);
      blockwrite(outfile,buffer,numread);
      done := (numread<bufsize);
    end;
  close(infile);
  close(outfile);
end;

procedure movefile(oldfn,newfn: string);

var
  f: file;

begin
  copyfile(oldfn,newfn);
  assign(f,oldfn);
  erase(f);
end;

function atoi(s: string): integer;

var
  code: word;
  result: integer;

begin
  val(s,result,code);
  atoi := result;
end;

function integertozstring(i, width: integer): string;

var
  result: string;

begin
  str(i,result);
  while length(result)<width do
    result := '0'+result;
  integertozstring := result;
end;

function itoa(i: integer): string;

begin
  itoa := integertozstring(i,0);
end;

function max(a,b: integer): integer;

begin
  if a<b then max := b else max := a;
end;

function getuniqfile(basedir: string): string;

{basedir has to end in \}

var
  result: integer;
  fileinfo: searchrec;

begin
  result := 0;
  findfirst(basedir+'*',archive,fileinfo);
  while doserror=0 do
    begin
      result := max(result,atoi(fileinfo.name));
      findnext(fileinfo);
    end;
  getuniqfile := basedir+itoa(result+1);
end;

procedure movetonews(filen: string);

begin
  writeln(filen,' => ',getuniqfile(basedir));
  movefile(filen,getuniqfile(basedir));
end;

begin
  if paramcount<2 then
    usage;
  basedir := paramstr(1)+'\';
  for parm := 2 to paramcount do
    begin
      filespec := paramstr(parm);
      tempi := length(filespec);
      repeat
        dec(tempi);
      until (filespec[tempi]='\') or (filespec[tempi]=':') or (tempi<=1);
      if (pos('\',filespec)=0) and (pos(':',filespec)=0) then
        filespec:=''
      else
        filespec:=copy(filespec,1,tempi);
      findfirst(paramstr(parm),archive,fileinfo);
      while doserror=0 do
        begin
          movetonews(filespec+fileinfo.name);
          findnext(fileinfo);
        end;
    end;
end.